R Notebook

library(listviewer)

Error in library(listviewer) : there is no package called ‘listviewer’

(localities<-read_csv("Marks_Mox - Sheet1.csv"))

Parsed with column specification:
cols(
  CatalogNumber = col_integer(),
  ScientificName = col_character(),
  `# of individuals` = col_character(),
  Locality = col_character(),
  Country = col_character(),
  YearCollected = col_integer(),
  Photo = col_character(),
  species = col_character(),
  drainage = col_character(),
  river = col_character()
)

localities %>%
  select(CatalogNumber,species,drainage,river)%>%
  rename(cat_num=CatalogNumber)->loc

#files<-paste0("Mox_images/shapes/TU198404_",1:6,"_L.txt")
a<-readShapes(file = "Mox_images/shapes/",fields=c("landmarks.scaled","curves.scaled"))

Put landmark data into a tibble.

data<-tibble(num=attr(a$landmarks.scaled,"dimnames")[[3]],
       fixedlm=array_branch(a$landmarks.scaled,margin = 3),
       c_body_ant=map(a$curves.scaled,"body_ant"),
       c_body_post=map(a$curves.scaled,"body_post"),
       c_opercle=map(a$curves.scaled,"opercle"))

data %>%
  mutate(cat_num=str_extract(num,"[0-9]+"))->data

data$cat_num<-as.integer(data$cat_num)
(data<-left_join(data,loc))

Joining, by = "cat_num"

convert curves into landmarks, evenly spaced along curves. Bind fixed and semi-landmarks together and remove duplicates.

data %>%
  mutate(body_ant=map(c_body_ant,~pointsAtEvenSpacing(.x,n=10)))%>%
  mutate(body_post=map(c_body_post,~pointsAtEvenSpacing(.x,n=10)))%>%
  mutate(opercle=map(c_opercle,~pointsAtEvenSpacing(.x,n=5))) %>%
  mutate(land_marks=pmap(list(fixedlm,body_ant,body_post,opercle),rbind))%>%
  mutate(land_marks=map(land_marks,~unique(.x)))->data

Convert list (and bind several arrays together) using sapply()

new_a<-sapply(data$land_marks, I, simplify="array")

Generate plot to aid in defining sliding, semi-landmarks using AUTO mode of define.sliders(). There are 20 fixed landmarks, curves are found between landmarks 1 and 2 (anterior, dorsal body), 3 and 4 (posterior, dorsal body), and 10 and 11 (opercle)

dd<-as.data.frame(new_a[,,1])
dd$label<-1:length(dd$V1)
ggplot(dd,aes(V1,V2))+
  geom_point(alpha=0.7)+
  geom_text(label=dd$label,check_overlap = F,nudge_x = 1,size=3)

Generate semi-landmarks matrix for gpagen using define.sliders().

curves<-rbind(define.sliders(c(1,29:36,2)),
              define.sliders(c(3,21:28,4)),
              define.sliders(c(10,37:39,11)))

gpa<-gpagen(new_a,curves = curves)

  |                                                                                                
  |                                                                                          |   0%
  |                                                                                                
  |==================                                                                        |  20%
  |                                                                                                
  |====================================                                                      |  40%
  |                                                                                                
  |======================================================                                    |  60%
  |                                                                                                
  |========================================================================                  |  80%
  |                                                                                                
  |==========================================================================================| 100%

gpa

Call:
gpagen(A = new_a, curves = curves) 



Generalized Procrustes Analysis
with Partial Procrustes Superimposition

20 fixed landmarks
19 semilandmarks (sliders)
2-dimensional landmarks
6 GPA iterations to converge
Minimized squared Procrustes Distance used


Consensus (mean) Configuration

                 X             Y
 [1,] -0.189281738 -0.0189355171
 [2,]  0.029592627  0.0433187831
 [3,]  0.103524503  0.0239729400
 [4,]  0.291068290  0.0149234806
 [5,]  0.292742681 -0.0400237890
 [6,]  0.222344247 -0.0435484505
 [7,]  0.181619322 -0.0590318512
 [8,]  0.055112150 -0.0672313024
 [9,] -0.083360093 -0.0516471862
[10,] -0.094899473 -0.0507447190
[11,] -0.101073595  0.0135330548
[12,] -0.147012042 -0.0045122369
[13,] -0.157483228 -0.0047507502
[14,] -0.154671153  0.0022745793
[15,] -0.146665372  0.0066204770
[16,] -0.138702202  0.0040788669
[17,] -0.135991983 -0.0042341649
[18,] -0.138967991 -0.0116696972
[19,] -0.147198036 -0.0151300056
[20,] -0.154821657 -0.0116123547
[21,] -0.172223368  0.0001268433
[22,] -0.150280451  0.0134050233
[23,] -0.126763769  0.0226131185
[24,] -0.102893650  0.0294643374
[25,] -0.077947451  0.0350178375
[26,] -0.051682381  0.0387421906
[27,] -0.024668132  0.0410672890
[28,]  0.003771183  0.0422487283
[29,]  0.124174046  0.0207716628
[30,]  0.145969680  0.0178351614
[31,]  0.167130740  0.0151424861
[32,]  0.188055037  0.0127531300
[33,]  0.208889045  0.0106019815
[34,]  0.229635235  0.0089255399
[35,]  0.250139983  0.0082879256
[36,]  0.270933418  0.0107036636
[37,] -0.087792062 -0.0356799752
[38,] -0.087322415 -0.0180784465
[39,] -0.092567093 -0.0010343920

plotAllSpecimens(gpa$coords,mean=F)

plot PCA

PCA <- plotTangentSpace(gpa$coords,warpgrids = F)

pca %>%
  group_by(id) %>%
  mutate(hull = 1:n(), hull = factor(hull, chull(PC1, PC2)))%>%
  arrange(as.numeric(hull))->pca

Unequal factor levels: coercing to characterbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vector

M<-mshape(gpa$coords)
PC<-PCA$pc.scores[,1:2]
preds<-shape.predictor(gpa$coords,x=PC,Intercept = FALSE,
                       pred1=c(-0.05,0.04)) 
                       
GP<-gridPar(pt.size=0.5,tar.pt.size=0.5,n.col.cell = 50)      
plotRefToTarget(M,preds$pred1,mag = 2,method = "vector",gridPars = GP)